use warnings;
use strict;
require LWP::UserAgent;

# set to 1 if your system doesn't have Compress::Zlib?
# SSL should no longer be required, nzb decompression could be an issue
# gunzip, instead of LWP decode, is used when this is enabled
my $NoZlib=0;

# wfnzb.cgi Binsearch functions
# $cgi->param('kw'), $cgi->param('ng'), $cgi->param('ag'), $cgi->param('re')
sub BinsearchQuery {
	#my ($keyword, $group, $age, $returns) = @_;
	my ($cgi) = @_;
	
	my $cats = 'in <SELECT NAME="ca">';
	my @cats = split (/\|/, $VAR{'Categories'});
	for (@cats){
		$cats .= "<option value=\"$_\">$_</option>\n";
	}
	if ($VAR{'HoldDir'} and -e $VAR{'HoldDir'}){
		$cats .= "<option value=\"HoldDir\">hold</option>\n";
	}
	$cats .='</SELECT> category';
	
	my $url;
	#my $history;
	my $qa = $cgi->param('ag');
	if ($qa eq 'all'){ $qa = ''; }
	if ($cgi->param('ng') eq 'popular'){#$cgi->param('ng'), $cgi->param('ag'), $cgi->param('re'));
		$url = 'http://www.binsearch.info/?q='.$cgi->param('kw').'&max='.$cgi->param('re').'&adv_age='.$qa.'&server=';
		#$history = "<A HREF=\"$VAR{'WfCgi'}?do=Binsearch_form&amp;kw=$keyword&amp;ng=&amp;ag=$qa&amp;re=$returns\">$keyword</A>";
		&Print ("Binsearch: $url (BS23)", 5, 0);
	}
	elsif ($cgi->param('ng') eq 'other'){
		$url = 'http://www.binsearch.info/?q='.$cgi->param('kw').'&max='.$cgi->param('re').'&adv_age='.$qa.'&server=2';
		#$url = "http://www.binsearch.info/?q=$keyword&max=$returns&adv_age=$qa&server=2";
		#$history = "<A HREF=\"$VAR{'WfCgi'}?do=Binsearch_form&amp;kw=$keyword&amp;ng=&amp;ag=$qa&amp;re=$returns\">$keyword</A>";
		&Print ("Binsearch: $url (BS23)", 5, 0);
	}
	elsif ($cgi->param('ng')){
		#http://www.binsearch.info/index.php?q=harry+potter&m=&max=25&adv_g=alt.binaries.e-book.palm&adv_age=99&adv_sort=date&minsize=&maxsize=&font=&postdate=
		$url = 'http://www.binsearch.info/index.php?q='.$cgi->param('kw').'&max='.$cgi->param('re').'&adv_g='.$cgi->param('ng').'&adv_age='.$qa.'&adv_sort=date';
		#$url = "http://www.binsearch.info/index.php?q=$keyword&max=$returns&adv_g=$group&adv_age=$qa&adv_sort=date";
		#$history = "<A HREF=\"$VAR{'WfCgi'}?do=Binsearch_form&amp;kw=$keyword&amp;ng=$group&amp;ag=$qa&amp;re=$returns\">$keyword</A>";
		&Print ("Binsearch: $url (BS23)", 5, 0);
	}
	my $server = '';
	my $user_agent = LWP::UserAgent->new;
	$user_agent->agent("Mozilla/8.1");
	$user_agent->default_header('Accept-Encoding' => 'gzip, x-gzip, deflate');
	#my $response = $user_agent->get($url);
	my $rows;

	##########
	if ($NoZlib){
		my $response = $user_agent->get($url, ':content_file' => "$VAR{'HtmlDir'}/binsearch.gz");
		unless ($response->is_success){ 
			#&FetchError ($response->status_line, "Binsearch fetch failed", 'BS70'); 
			&Print ('  Binsearch fetch failed, '.$response->status_line.' (BS70)', 1, 1);
		}
		else { 
			unless ($VAR{'Gunzip'}){ $VAR{'Gunzip'} = 'gunzip'; }
			if (system ("$VAR{'Gunzip'} \"$VAR{'HtmlDir'}/binsearch.gz\"") == 0){
				open (HTM, "<$VAR{'HtmlDir'}/binsearch") or &Print ("  Couldn't open binsearch, $! (100)", 1, 1);
				while (<HTM>){
					# first regex for sever 2, second for primary server - if strictly true the first would always have server=2 (the 2nd never)
					if (m!^<script language.+?action="[^"]+server=(2)?"!){
						if ($1){ 
							$server = 2; 
							&Print (" regex 1 match for server 2 (BS50)", 5, 0);
						}
						else { &Print (" regex 1 match for main server (BS53)", 5, 0); }
					}
					elsif (m!^<p><iframe.+?action="[^"]+server=(2)?"!){
						if ($1){ 
							$server = 2; 
							&Print (" regex 2 match for server 2 (BS67)", 5, 0);
						}
						else { &Print (" regex 2 match for main server (BS69)", 5, 0); }
					}
					if (m!^(<tr bgcolor.+<td>\d+[mhd])<\!--!){
						$rows = $1;
						$rows =~ s! class="\w"!!g;
						$rows =~ s!<tr[^>]+!<tr!g;
						$rows =~ s!</?span>!!g;
						$rows =~ s!<a href="/?!<a href="http://www.binsearch.info/!g;
						last;
					}
				}
				close HTM or warn $!;
				&Delete($VAR{'HtmlDir'}, 'binsearch', 'BS100');
			}
			else { &Print ("  Couldn't decompress $VAR{'HtmlDir'}/binsearch.gz, $! (BS71)", 1, 1); }
		}
	}
	else {
		my $response = $user_agent->get($url);
		unless ($response->is_success){ 
			&Print ('  Binsearch fetch failed, '.$response->status_line.' (BS70)', 1, 1);
		}
		else {
			my @html = split (/\n/, $response->decoded_content);
			#my $rows;
			for (@html) { 
				# first regex for sever 2, second for primary server - if strictly true the first would always have server=2 (the 2nd never)
				if (m!^<script language.+?action="[^"]+server=(2)?"!){
					if ($1){ 
						$server = 2; 
						&Print (" regex 1 match for server 2 (BS50)", 5, 0);
					}
					else { &Print (" regex 1 match for main server (BS53)", 5, 0); }
				}
				elsif (m!^<p><iframe.+?action="[^"]+server=(2)?"!){
					if ($1){ 
						$server = 2; 
						&Print (" regex 2 match for server 2 (BS67)", 5, 0);
					}
					else { &Print (" regex 2 match for main server (BS69)", 5, 0); }
				}
				if (m!^(<tr bgcolor.+<td>\d+[mhd])<\!--!){
					$rows = $1;
					$rows =~ s! class="\w"!!g;
					$rows =~ s!<tr[^>]+!<tr!g;
					$rows =~ s!</?span>!!g;
					$rows =~ s!<a href="/?!<a href="http://www.binsearch.info/!g;
					last;
				}
			}
		}
	}
# 		open (HTM, "<$VAR{'HtmlDir'}/Binsearch.html") or die $!;
# 		while (<HTM>){
# 			if (m!^\t{3}<P>History:(.+)!){
# 				$history .= $1;
# 				last;
# 			}
# 		} # $cgi->param('kw'), $cgi->param('ng'), $cgi->param('ag'), $cgi->param('re')
# 		close (HTM) or warn $!;
		open (HTM, ">$VAR{'HtmlDir'}/Binsearch.html") or die $!;
		print HTM &HtmHead ('Binsearch', '', $VAR{'HomeUrl'}, "Return to $VAR{'HomeName'}", '');
		&BinsearchForm ($cgi->param('kw'), $cgi->param('ng'), $cgi->param('ag'), $cgi->param('re'));
		if ($rows){
			print HTM qq~<form action="$VAR{'WfCgi'}" method="$VAR{'FormMethod'}"> 
			<INPUT TYPE="hidden" NAME="do" VALUE="Binsearch_fetch">
			<table CELLPADDING="10">$rows</table><br>
			Note: If you paste the full.title.episode.type.etc for the post you want (and have Rename enabled), PPWeb will run <br>
			the nzb through nzbprocess before queuing it. Nzbprocess rename is triggered by titles containing .'s or _'s.<br>
			NzbProcess will rename the nzb and format it per you settings - including fetching an episode title, if appropriate.<br><br>
			~;
			print HTM 'Save as: <INPUT TYPE="text" SIZE="50" NAME="kw" VALUE="'.$cgi->param('kw').'">.nzb '.$cats.'<br><br>';
			print HTM '<INPUT TYPE="hidden" NAME="ng" VALUE="'.$cgi->param('ng').'">';
			print HTM '<INPUT TYPE="hidden" NAME="ag" VALUE="'.$cgi->param('ag').'">';
			print HTM '<INPUT TYPE="hidden" NAME="re" VALUE="'.$cgi->param('re').'">';
			print HTM qq~<INPUT TYPE="hidden" NAME="se" VALUE="$server">
			<INPUT TYPE="submit" VALUE="Fetch nzb"></form>~;
		}
		#	<P>History: $history</P>~;
		else { print HTM "<P>No Results</P>"; }
# 		if ($user_agent->is_protocol_supported( 'https' )){
# 			print HTM '<P>yes</P>';
# 		}
		#print HTM '<P>'.$response->headers->as_string.'</P>';
		#my $menu = &HtmlMenu;
		print HTM &HtmFoot ($VAR{'HomeUrl'}, "Return to $VAR{'HomeName'}", '');
		close (HTM) or warn $!;
		#&Print ("  Wrote Binsearch.html (FN24)", 3, 0);
		print $cgi->redirect($VAR{'Protocol'}.$VAR{'Host'}.$VAR{'HtmlUrl'}.'/Binsearch.html');
		#print "Status: 303 See Other\nLocation: $VAR{'Protocol'}$VAR{'Host'}$VAR{'HtmlUrl'}/Binsearch.html\n\n";
# 	}
# 	else { 
# 		#&FetchError ($response->status_line, 'Binsearch page fetch failed', 'FN81'); 
# 		&Print ('  Binsearch fetch failed, '.$response->status_line.' (BS68)', 1, 1);
# 	}
}

# $var{'kw'},  $var{'ca'},  $var{'ng'},  $var{'ag'},  $var{'re'},  $var{'se'} application/x-nzb
sub BinsearchFetch {
	#my (%var) = @_;
	my ($cgi) = @_;
	my %var = $cgi->Vars;
	
	&Print ("Starting Binsearch fetch (BS69)", 3, 0);
	
	my $server = '';
	if ($var{'se'}){ $server = 2; }
	
# 	my $path = "$VAR{'NzbDir'}/$var{'ca'}/$var{'kw'}.nzb.gz";
# 	if ($var{'ca'} eq 'HoldDir'){
# 		$path = "$VAR{'HoldDir'}/$var{'kw'}.nzb.gz";
# 	}
	my $path = "$VAR{'NzbDir'}/$var{'ca'}/$var{'kw'}.nzb";
	if ($var{'ca'} eq 'HoldDir'){
		$path = "$VAR{'HoldDir'}/$var{'kw'}.nzb";
	}

	my $user_agent = LWP::UserAgent->new;
	$user_agent->agent("Mozilla/8.1");
	$user_agent->default_header('Accept-Encoding' => 'gzip, x-gzip, deflate');
	
	my $url;
	my $qa = $var{'ag'};
	if ($qa eq 'all'){ $qa = ''; }
	if ($var{'ng'} eq 'popular'){
		$url = "http://www.binsearch.info/fcgi/nzb.fcgi?q=$var{'kw'}&max=$var{'re'}&adv_age=$qa&server=";
		#&Print ("  URL:$url (BS65)", 5, 0);
	}
	elsif ($var{'ng'} eq 'other'){
		$url = "http://www.binsearch.info/fcgi/nzb.fcgi?q=$var{'kw'}&max=$var{'re'}&adv_age=$qa&server=2";
		#&Print ("  URL:$url (BS66)", 5, 0);
	}
	elsif ($var{'ng'}){
		$url = "http://www.binsearch.info/fcgi/nzb.fcgi?q=$var{'kw'}&max=$var{'re'}&adv_g=$var{'ng'}&adv_age=$qa&server=$server";
		#&Print ("  URL:$url (BS67)", 5, 0);
	}
	
	my %fields;
	for my $key ( keys %var ) {
		if ($key =~ m!^\d+$!){
			$fields{$key} = $var{$key};
			#&Print ("  $key => $fields{$key} (BS68)", 5, 0);
			# enabled check boxes
		}
	}
	$fields{'action'} = 'nzb';
	#&Print ("  action => $fields{'action'} (BS68)", 5, 0);
	
	#my $response = $user_agent->post($url, Content => \%fields, ':content_file' => $path);
	my $response = $user_agent->post($url, Content => \%fields);
	unless ($response->is_success){ 
		#&FetchError ($response->status_line, "Binsearch fetch failed", 'BS70'); 
		&Print ('  Binsearch fetch failed, '.$response->status_line.' (BS70)', 1, 1);
	}
	else { 
# 		my $cd = $response->header('Content-Disposition');
# 		if ($cd){
# 			&Print ("  Content-Disposition: $cd (FZ01)", 5, 0);
# 		}
		open(NZB, ">$path")  or &Print ("  Couldn't open $path, $! (BS70)", 1, 1);
		print NZB $response->decoded_content;
		close (NZB) or warn $!;
		&Print ("  Got $path (BS70)", 3, 0);
# 		&Print ("  Got $var{'kw'}.nzb.gz (BS70)", 3, 0);
# 		unless ($VAR{'Gunzip'}){ $VAR{'Gunzip'} = 'gunzip'; }
# 		unless (system ("$VAR{'Gunzip'} '$path'") == 0){
# 			&Print ("  Couldn't decompress $var{'kw'}.nzb.gz, $! (BS71)", 1, 1);
# 		}
		if ($VAR{'NzbScan'}){ system qx($VAR{'NzbgetRun'} -S > /dev/null); }
	}
	print $cgi->redirect($VAR{'Protocol'}.$VAR{'Host'}.$VAR{'HomeUrl'});
	#print "Status: 303 See Other\nLocation: $VAR{'Protocol'}$VAR{'Host'}$VAR{'HomeUrl'}\n\n";
}

sub BinsearchForm {
	my ($kw, $gr, $ag, $re) = @_;
	unless ($gr){ $gr='popular'; }
	my $grn = $gr;
	$grn =~ s!^alt\.binaries!a.b!;
	unless ($ag){ $ag=14; }
	unless ($re){ $re=25; }
	
	my $groups = '';
	if ($VAR{'Newsgroups'}){ $groups = &Newsgroups; }

	print HTM qq~
		<P><form action="$VAR{'WfCgi'}" method="$VAR{'FormMethod'}">
		<INPUT TYPE="hidden" NAME="do" VALUE="Binsearch_form">
		Find: <INPUT TYPE="text" SIZE="20" NAME="kw" VALUE="$kw">&nbsp;&nbsp;&nbsp;
		Group(s): <SELECT NAME=\"ng\">\n
		<option value=\"$gr\" selected>$grn</option>\n
		<option value=\"popular\">popular</option>\n
		<option value=\"other\">other</option>\n
		$groups
		</SELECT>&nbsp;&nbsp;&nbsp;
		Days &lt;= <select name="ag">
		<option selected>$ag</option>
		<option>7</option>
		<option>14</option>
		<option>21</option>
		<option>50</option>
		<option>70</option>
		<option>99</option>
		<option>120</option>
		<option>300</option>
		<option>all</option>
		</SELECT>&nbsp;&nbsp;&nbsp;
		Results &lt;= <SELECT NAME="re">
		<option selected>$re</option>
		<option>25</option>
		<option>50</option>
		<option>100</option>
		<option>250</option>
		</SELECT>&nbsp;&nbsp;&nbsp;
		<INPUT TYPE="submit" VALUE="Search"></form>
		<br></P>\n
	~;
}

sub Newsgroups {
	my $options = '';
	my @groups = split (/\|/, $VAR{'Newsgroups'});
	@groups = sort (@groups);
	foreach my $group (@groups){
		my $sg = $group;
		$sg =~ s!^alt\.binaries!a.b!;
		$options .= "<option value=\"$group\">$sg</option>\n";
	}
	return $options;
}

sub BinsearchPage {
	open (HTM, ">$VAR{'HtmlDir'}/Binsearch.html") or die $!;
	print HTM &HtmHead ('Binsearch', '', $VAR{'HomeUrl'}, "Return to $VAR{'HomeName'}", '');
	&BinsearchForm ('', '', '', '');
	#my $menu = &HtmlMenu;
	print HTM &HtmFoot ($VAR{'HomeUrl'}, "Return to $VAR{'HomeName'}", '');
	close (HTM) or warn $!;
	&Print ("  Wrote Binsearch.html (FN24)", 3, 0);


}
# sub BinsearchHistory {
# 	my $history = '';
# 	open (HTM, "<$VAR{'HtmlDir'}/Binsearch.html") or die $!;
# 	while (<HTM>){
# 		if (m!^\t{3}<P>History:(.+)!){
# 			$history = $1;
# 		}
# 	}
# 	close (HTM) or warn $!;
# 	return $history;
# }

1;
